home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / DDPLUS71.ZIP / SETUP.ZIP / SETUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-09  |  6.3 KB  |  195 lines
  1. (****************************************************)
  2. (*   Programming:  Bob Dalton                       *)
  3. (*   Demonstration Program for using Turbo Vision   *)
  4. (*    as a game configuration and setup program     *)
  5. (*    for BBS Doors                                 *)
  6. (****************************************************)
  7.  
  8. PROGRAM SETUP;    (* Initialization Program -- sets/resets player file *)
  9. {$R-}
  10. {$S+}
  11. {$I+}
  12. {$N-}
  13. {$M 65520,16384,655360}
  14.  
  15. Uses
  16.  Crt,
  17.  DOS,
  18.  WorldVar,
  19.  App,
  20.  Drivers,
  21.  Objects, {Objects has TRect}
  22.  Views,   {Views has cmXXXX constants}
  23.  Menus,   {Menus has TStatusLine}
  24.  SDialogs;
  25.  
  26. TYPE
  27.   pCodeLine = ^TCodeLine;
  28.   TCodeLine = object(TStatusLine)
  29.     function Hint(AHelpCtx: Word): string; virtual;
  30.    end;
  31.  
  32.   TMain = object(TApplication)
  33.    procedure InitStatusLine; virtual;
  34.    procedure InitMenuBar; virtual;
  35.    procedure HandleEvent(var Event: TEvent); virtual;
  36.    procedure Idle; virtual;
  37.   end;
  38.  
  39. VAR
  40.   Main           : TMain;
  41.  
  42. {The below function assigns strings to help (hint) commands}
  43. function TCodeLine.Hint(AHelpCtx: Word): String;
  44. begin
  45.    If AHelpCtx < hcExitSave  then Hint := '' {hcExitSave = First item in case list}
  46.    else case AHelpCtx of
  47.       hcExitSave           : Hint := 'Save game configuration settings - Do first!';
  48.       hcNoSave             : Hint := 'Exit program - Be sure to save first!';
  49.       hcFirst              : Hint := 'First Sub-Menu Choice';
  50.       hcSecond             : Hint := 'Second Sub-Menu Choice';
  51.       hcThird              : Hint := 'Third Sub-Menu Choice';
  52.       hcHowManySoldiers    : Hint := 'Starting number of soldiers';
  53.       hcHowManyTanks       : Hint := 'Starting number of tanks';
  54.       hcHowMuchMoney       : Hint := 'Starting amount of money for each player';
  55.       hcHowManyGenerals    : Hint := 'Starting number of generals';
  56.       else Hint := 'Sorry, no help available for this item.'
  57.       end;
  58.    end;
  59.  
  60. {The below procedure checks for the presence of a
  61.  three line key.dat file and then reads it. If the
  62.  "RegisterNumber" variable matches "ZULUTRIBE" then
  63.  the variable called "Registered" is returned as
  64.  true, if not then it is returned as false}
  65.  
  66. Procedure CheckReg(VAR Registered:Boolean);
  67.  VAR DelFile:Text;S:PathStr;X,Z:Integer;
  68.  Begin
  69.    Registered:=False;
  70.    Assign(DelFile,'KEY.DAT');
  71.    Reset(DelFile);
  72.    IF NOT EOF(DelFile) THEN BEGIN
  73.     Readln(DelFile,Buyer);
  74.     Readln(DelFile,NameOfBoard);
  75.     Readln(DelFile,RegisterNumber);
  76.     Close(DelFile);
  77.    If RegisterNumber='ZULUTRIBE' Then REGISTERED:=TRUE;
  78.    End;
  79. End;
  80.  
  81. {This procedure reads the Month, Day and Year
  82.  from the system and returns the values in the
  83.  variables called "Month", "Day" and "Year"}
  84.  
  85. Procedure GetDate1(VAR Month:Word;
  86.                    VAR day:Word;
  87.                    VAR year:Word);
  88.  VAR MyRegs:Registers;
  89.  
  90.  Begin
  91.   MyRegs.AH:=$2A;
  92.   MSDOS(MyRegs);
  93.   Month:=MyRegs.DH;
  94.   Day:=MyRegs.DL;
  95.   Year:=MyRegs.CX;
  96.  End;
  97.  
  98. {The below function is similar to a string case unit.
  99.  This provides one line "hints" in the turbo vision
  100.  status bar portion of the screen whenever the cursor
  101.  is moved to that portion of the menu which calls the
  102.  hint.}
  103.  
  104. {This procedure shows the listed items always on the Status line}
  105. procedure TMain.InitStatusLine;
  106. var R: TRect;
  107. begin
  108.    R.Assign(0,24,80,25);
  109.    StatusLine := New(PCodeLine, Init(R,
  110.       NewStatusDef(0, 999,
  111.          StdStatusKeys(
  112.          NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  113.          nil)),
  114.       nil))); {More stauts definitions here}
  115.    end;
  116.  
  117. {Shows choices on menu bar and in sub-menu boxes}
  118. procedure TMain.InitMenuBar;
  119. var R   : TRect;
  120. begin
  121.    R.Assign(0,0,80,1); {I suggest you do NOT change this}
  122.    MenuBar := New(PMenuBar, Init(R, NewMenu(
  123.    {Each NewSubMenu Item is another menu choice}
  124.    NewSubMenu('~F~irst ', hcFirst, NewMenu(
  125.       {Each NewItem is another sub-menu choice}
  126.       {Item between ~ ~ are highlighted in color}
  127.       {kbNoKey means no hot key assigned. To assign a key
  128.        would look like this "kbF1"}
  129.       {Items beginning with "cm" are commands}
  130.       {Items beginning with "hc" are hint lines}
  131.       NewItem('~S~ave Settings', 'F1', kbF1, cmExitSave, hcExitSave,
  132.       NewItem('E~x~it Program', 'F2', kbF2, cmQuit, hcNoSave,
  133.       nil))),  {Add a ")" for each additional NewItem you add}
  134.    NewSubMenu('~S~econd  ', hcSecond, NewMenu(
  135.       NewItem('~S~oldiers', '', kbNoKey, cmHowManySoldiers, hcHowManySoldiers,
  136.       NewItem('~T~anks', '', kbNoKey, cmHowManyTanks, hcHowManyTanks,
  137.       nil))), {add on extra ")" for each additional NewItem you add}
  138.    NewSubMenu('~T~hird  ', hcThird, NewMenu(
  139.       NewItem('~M~oney', '', kbNoKey, cmHowMuchMoney, hcHowMuchMoney,
  140.       NewItem('~G~enerals', '', kbNoKey, cmHowManyGenerals, hcHowManyGenerals,
  141.       nil))), {add on extra ")" for each additional NewItem you add}
  142.    nil)))))); {Add an extra ")" for each additional NewSubMenu line}
  143.    end;
  144.  
  145. Procedure SetupGlob(VAR Glob:GlobRec); {Initialize your record variables}
  146.  
  147.   Begin
  148.    Glob.Soldiers:=250;{Your default settings per the button setting you made}
  149.    Glob.Tanks   :=3;
  150.    Glob.Money   :=2000;
  151.    Glob.Generals:=1;
  152.   End;
  153.  
  154. Procedure SaveExit;
  155.  Begin
  156.   Assign(Globfile,'GLOB.DAT');
  157.   ReWrite(Globfile);
  158.   Write(GlobFile,Glob);
  159.   Close(GlobFile);
  160.  End;
  161.  
  162. procedure TMain.HandleEvent;
  163. begin
  164.    If (Event.What and evCommand)<>0 then
  165.    begin
  166.     case Event.Command of
  167.       {When a submenu item is selected it will call the following case statements}
  168.       {Command}          {Calls this function or procedure}
  169.       cmExitSave       : SaveExit;
  170.       cmHowManySoldiers: HowManySoldiers;
  171.       cmHowManyTanks   : HowManyTanks;
  172.       cmHowMuchMoney   : HowMuchMoney;
  173.       cmHowManyGenerals: HowManyGenerals;
  174.      end;
  175.     end;
  176.    inherited HandleEvent(Event);
  177.    end;
  178.  
  179. procedure TMain.Idle; {Handles situation when nothing happens}
  180. begin
  181.    inherited Idle;
  182.    end;
  183.  
  184. Begin
  185.   GetDate1(Month,Day,Year); {Gets the Month, Day and Year from the system}
  186.   Registered:=False;      {Initializes the register variable}
  187.   CheckReg(Registered); {Checks registration}
  188.   SetupGlob(glob); {Initializes the record variables}
  189.   {The next three lines MUST be present or the program will NOT work}
  190.   Main.Init;  {Initializes Turbo Vision}
  191.   Main.Run;   {Runs Turbo Vision}
  192.   Main.Done;  {Closes Turbo Vision}
  193. End.
  194.  
  195.